home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / cafead1a / connecti.bas < prev    next >
BASIC Source File  |  1999-10-05  |  5KB  |  177 lines
  1. Attribute VB_Name = "Connected"
  2. Option Explicit
  3. 'This module was submitted by Timmy Atkins title:
  4. 'ISP Stuff on 5-12-99
  5. Public Const HKEY_CLASSES_ROOT = &H80000000
  6. Public Const HKEY_CURRENT_USER = &H80000001
  7. Public Const HKEY_LOCAL_MACHINE = &H80000002
  8. Public Const HKEY_USERS = &H80000003
  9. Public Const HKEY_PERFORMANCE_DATA = &H80000004
  10. Public Const HKEY_CURRENT_CONFIG = &H80000005
  11. Public Const HKEY_DYN_DATA = &H80000006
  12. Public Const ERROR_SUCCESS = 0&
  13. Public Const APINULL = 0&
  14. Public Const MAX_STRING_LENGTH As Integer = 256
  15.  
  16. Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
  17. Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
  18. ' RegQueryValueEx: If you declare the lpData parameter as String,
  19. ' you must pass it By Value.
  20.  
  21. Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
  22. ' Remote Access Services (RAS) APIs.
  23. Public Const RAS_MAXENTRYNAME As Integer = 256
  24. Public Const RAS_MAXDEVICETYPE As Integer = 16
  25. Public Const RAS_MAXDEVICENAME As Integer = 128
  26. Public Const RAS_RASCONNSIZE As Integer = 412
  27.  
  28. Public Type RasEntryName
  29.    dwSize As Long
  30.    szEntryName(RAS_MAXENTRYNAME) As Byte
  31. End Type
  32.  
  33. Public Type RasConn
  34.   dwSize As Long
  35.   hRasConn As Long
  36.   szEntryName(RAS_MAXENTRYNAME) As Byte
  37.   szDeviceType(RAS_MAXDEVICETYPE) As Byte
  38.   szDeviceName(RAS_MAXDEVICENAME) As Byte
  39. End Type
  40.  
  41. Public Declare Function RasEnumConnections Lib "rasapi32.dll" Alias "RasEnumConnectionsA" (lpRasConn As Any, lpcb As Long, lpcConnections As Long) As Long
  42.  
  43. Public Declare Function RasHangUp Lib "rasapi32.dll" Alias "RasHangUpA" (ByVal hRasConn As Long) As Long
  44. Public gstrISPName As String
  45. Public ReturnCode As Long
  46.  
  47. Public Function ByteToString(bytString() As Byte) As String
  48. Dim i As Integer
  49. ByteToString = ""
  50. i = 0
  51. While bytString(i) = 0&
  52. ByteToString = ByteToString & Chr(bytString(i))
  53. i = i + 1
  54. Wend
  55. End Function
  56.  
  57. Public Function Connected_To_ISP() As Boolean
  58. Dim hKey As Long
  59. Dim lpSubKey As String
  60. Dim phkResult As Long
  61. Dim lpValueName As String
  62. Dim lpReserved As Long
  63. Dim lpType As Long
  64. Dim lpData As Long
  65. Dim lpcbData As Long
  66. Connected_To_ISP = False
  67. lpSubKey = "System\CurrentControlSet\Services\RemoteAccess"
  68. ReturnCode = RegOpenKey(HKEY_LOCAL_MACHINE, lpSubKey, phkResult)
  69.  
  70. If ReturnCode = ERROR_SUCCESS Then
  71. hKey = phkResult
  72. lpValueName = "Remote Connection"
  73. lpReserved = APINULL
  74. lpType = APINULL
  75. lpData = APINULL
  76. lpcbData = APINULL
  77. ReturnCode = RegQueryValueEx(hKey, lpValueName, lpReserved, lpType, _
  78. ByVal lpData, lpcbData)
  79. lpcbData = Len(lpData)
  80. ReturnCode = RegQueryValueEx(hKey, lpValueName, lpReserved, lpType, _
  81.      lpData, lpcbData)
  82.  
  83. If ReturnCode = ERROR_SUCCESS Then
  84. If lpData = 0 Then
  85. ' Not Connected
  86. 'MsgBox "Not Connected To ISP."
  87. Else
  88. ' Connected
  89. Connected_To_ISP = True
  90. 'MsgBox "Currently Connected To ISP."
  91. End If
  92. End If
  93. RegCloseKey (hKey)
  94. End If
  95. End Function
  96.  
  97.  
  98. Public Function Get_ISP_Name() As String
  99. Dim hKey As Long
  100. Dim lpSubKey As String
  101. Dim phkResult As Long
  102. Dim lpValueName As String
  103. Dim lpReserved As Long
  104. Dim lpType As Long
  105. Dim lpData As String
  106. Dim lpcbData As Long
  107. Get_ISP_Name = ""
  108.  
  109. If Connected_To_ISP Then
  110. lpSubKey = "RemoteAccess"
  111. ReturnCode = RegOpenKey(HKEY_CURRENT_USER, lpSubKey, phkResult)
  112.  
  113. If ReturnCode = ERROR_SUCCESS Then
  114. hKey = phkResult
  115. lpValueName = "Default"
  116. lpReserved = APINULL
  117. lpType = APINULL
  118. lpData = APINULL
  119. lpcbData = APINULL
  120. ReturnCode = RegQueryValueEx(hKey, lpValueName, lpReserved, _
  121. lpType, ByVal lpData, lpcbData)
  122. lpData = String(lpcbData, 0)
  123. ReturnCode = RegQueryValueEx(hKey, lpValueName, lpReserved, _
  124. lpType, ByVal lpData, lpcbData)
  125.  
  126. If ReturnCode = ERROR_SUCCESS Then
  127. ' Chop off the end-of-string character.
  128. Get_ISP_Name = Left(lpData, lpcbData - 1)
  129. End If
  130. RegCloseKey (hKey)
  131. End If
  132. End If
  133. MsgBox "" & Get_ISP_Name
  134. End Function
  135.  
  136. Public Sub HangUp()
  137. Dim i As Long
  138. Dim lpRasConn(255) As RasConn
  139. Dim lpcb As Long
  140. Dim lpcConnections As Long
  141. Dim hRasConn As Long
  142. lpRasConn(0).dwSize = RAS_RASCONNSIZE
  143. lpcb = RAS_MAXENTRYNAME * lpRasConn(0).dwSize
  144. lpcConnections = 0
  145. ReturnCode = RasEnumConnections(lpRasConn(0), lpcb, lpcConnections)
  146. ' Drop ALL the connections that match the currect
  147. ' connections name.
  148. If ReturnCode = ERROR_SUCCESS Then
  149. For i = 0 To lpcConnections - 1
  150. If Trim(ByteToString(lpRasConn(i).szEntryName)) = Trim(gstrISPName) Then
  151. hRasConn = lpRasConn(i).hRasConn
  152. ReturnCode = RasHangUp(ByVal hRasConn)
  153. End If
  154. Next i
  155. End If
  156. ' It takes about 3 seconds to drop the connection.
  157. Wait (3)
  158. While Connected_To_ISP
  159. Wait (1)
  160. Wend
  161. End Sub
  162.  
  163. Public Sub Wait(sngSeconds As Single)
  164. Dim sngEndTime As Single
  165. sngEndTime = Timer + sngSeconds
  166. While Timer < sngEndTime
  167. DoEvents
  168. Wend
  169. End Sub
  170.  
  171.  
  172.  
  173.              
  174.                                              
  175.     
  176.  
  177.